module Heap(Heap, empty, Heap.read, write, alloc) where

import Control.Monad.Error
import qualified Data.Map as Map
import ResultState
import Accessor
import Pointer


data Heap a = Heap (Map.Map Pointer a) Pointer


instance Show a => Show (Heap a) where
    show (Heap m _) = show m


heapMap :: Accessor (Heap a) (Map.Map Pointer a)
------------------------------------------------
heapMap = (get, set)
    where
      get (Heap map _)     = map
      set (Heap _ ptr) map = Heap map ptr


heapNextPointer :: Accessor (Heap a) Pointer
--------------------------------------------
heapNextPointer = (get, set)
    where
      get (Heap _ ptr)     = ptr
      set (Heap map _) ptr = Heap map ptr


empty :: Heap a
---------------
empty = Heap Map.empty initialPointer


read :: e -> Pointer -> ResultState (Heap a) e a
------------------------------------------------
read e ptr = do r <- with heapMap $ Map.lookup ptr
                case r of
                  Nothing -> throwError e
                  Just a  -> return a


write :: Pointer -> a -> ResultState (Heap a) e ()
--------------------------------------------------
write ptr v = update heapMap $ Map.insert ptr v


nextPointer :: ResultState (Heap a) e Pointer
---------------------------------------------
nextPointer = do p <- get heapNextPointer
                 update heapNextPointer Pointer.next
                 return p


alloc :: a -> ResultState (Heap a) e Pointer
--------------------------------------------
alloc v = do p <- nextPointer
             update heapMap $ Map.insert p v
             return p
